home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / ctlib100.zip / INSTALL.LZH / ARRAYS7.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-12  |  4KB  |  157 lines
  1. {**************************************************************************}
  2. {*  BitSoft Development, L.L.C.                                           *}
  3. {*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
  4. {*  All rights reserved.                                                  *}
  5. {*  Containers Library demo                                               *}
  6. {**************************************************************************}
  7.  
  8. program Arrays7;
  9.  
  10. {$X+}
  11.  
  12. { Sample program for using a standard sorted array }
  13.  
  14. uses Containr, ctArrays,
  15.      {$ifdef Windows}
  16.      WinCtr;
  17.      {$else}
  18.      Crt;
  19.      {$endif}
  20.  
  21. type
  22.   PContact = ^TContact;
  23.   TContact = record
  24.     FirstName : string[15];
  25.     LastName : string[20];
  26.     Phone : string[18];
  27.     Company : string [25];
  28.   end; { TContact }
  29.  
  30. type
  31.   PSortedContactList = ^TSortedContactList;
  32.   TSortedContactList = object(TSortedStdArray)
  33.     function KeyOf(Item : Pointer) : Pointer; virtual;
  34.   end; { TSortedContactList }
  35.  
  36. function TSortedContactList.KeyOf(Item : Pointer) : Pointer;
  37. begin
  38.   KeyOf := @(PContact(Item)^.LastName);
  39. end;
  40.  
  41. procedure SetContactValues(ALastName, AFirstName, APhone,
  42.   ACompany : string; var ContactRec : TContact);
  43. begin
  44.   with ContactRec do
  45.   begin
  46.     FirstName := AFirstName;
  47.     LastName := ALastName;
  48.     Phone := APhone;
  49.     Company := ACompany;
  50.   end; { with }
  51. end;
  52.  
  53. procedure DisplayContacts(ContactList : PSequence);
  54.  
  55.   procedure PrintInfo (Item : Pointer); far;
  56.   begin
  57.     with PContact(Item)^ do
  58.       writeln(LastName, '':15 - Length(LastName),
  59.         FirstName, '':15 - Length(FirstName),
  60.         Phone, '':20 - Length(Phone),
  61.         Company, '':20 - Length(Company));
  62.   end;
  63.  
  64. begin
  65.   ContactList^.ForEach(@PrintInfo);
  66. end;
  67.  
  68. procedure DisplayFirst(ContactList : PSequence);
  69. var
  70.   Item : Pointer;
  71.   Index : LongInt;
  72. begin
  73.   Item := ContactList^.First(Index);
  74.   Writeln('First item:');
  75.   with PContact(Item)^ do
  76.     writeln(LastName, '':15 - Length(LastName),
  77.       FirstName, '':15 - Length(FirstName),
  78.       Phone, '':20 - Length(Phone),
  79.       Company, '':20 - Length(Company));
  80.   ContactList^.DoneItem(Item); { not required }
  81. end;
  82.  
  83. procedure DisplayLast(ContactList : PSequence);
  84. var
  85.   Item : Pointer;
  86.   Index : LongInt;
  87. begin
  88.   Item := ContactList^.Last(Index);
  89.   Writeln('Last item:');
  90.   with PContact(Item)^ do
  91.     writeln(LastName, '':15 - Length(LastName),
  92.       FirstName, '':15 - Length(FirstName),
  93.       Phone, '':20 - Length(Phone),
  94.       Company, '':20 - Length(Company));
  95.   ContactList^.DoneItem(Item); { not required }
  96. end;
  97.  
  98. procedure FindLastName(ContactList : PSequence; LastName : string);
  99. var
  100.   Item : Pointer;
  101.   Index : LongInt;
  102.  
  103.   function MatchLastName (Item : Pointer): boolean; far;
  104.   begin
  105.     MatchLastName := (LastName = PContact(Item)^.LastName);
  106.   end;
  107.  
  108. begin
  109.   Item := ContactList^.FirstThat(@MatchLastName, Index);
  110.   Writeln('Item found with last name ''', LastName, ''':');
  111.   with PContact(Item)^ do
  112.     writeln(LastName, '':15 - Length(LastName),
  113.       FirstName, '':15 - Length(FirstName),
  114.       Phone, '':20 - Length(Phone),
  115.       Company, '':20 - Length(Company));
  116.   ContactList^.DoneItem(Item); { not required }
  117. end;
  118.  
  119. var
  120.   ContactList : PSortedContactList;
  121.   Contact : TContact;
  122.  
  123. begin
  124.   ClrScr;
  125.  
  126.   { Create the array }
  127.   ContactList := New(PSortedContactList, Init(50, 10,  SizeOf(TContact)));
  128.  
  129.   { Insert the items in the array }
  130.   with ContactList^ do
  131.   begin
  132.     SetContactValues('Lewis', 'Carl', '(506) 83-780', 'Running, Corp.',
  133.       Contact);
  134.     Insert(@Contact);
  135.     SetContactValues('Benton', 'Michael', '(403) 33-973', 'ER, Inc.',
  136.       Contact);
  137.     Insert(@Contact);
  138.     SetContactValues('Wagner', 'Robert', '(906) 11-230', 'Symphony, Ltd.',
  139.       Contact);
  140.     Insert(@Contact);
  141.     SetContactValues('Smith', 'John', '(656) 75-843', 'InterComm, Corp.',
  142.       Contact);
  143.     Insert(@Contact);
  144.   end; { with }
  145.  
  146.   DisplayContacts(ContactList);
  147.   Writeln;
  148.   DisplayFirst(ContactList);
  149.   Writeln;
  150.   DisplayLast(ContactList);
  151.   Writeln;
  152.   FindLastName(ContactList, 'Wagner');
  153.  
  154.   { Dispose of the array }
  155.   Dispose(ContactList, Done);
  156. end.
  157.